home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / kcl.lha / c / fasl_pass1.c < prev    next >
C/C++ Source or Header  |  1987-06-04  |  10KB  |  430 lines
  1. /*
  2. (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. */
  4.  
  5. /*
  6.     fasl_pass1.c
  7.     DG-SPECIFIC
  8.  
  9.     fasl loader pass1 routines
  10. */
  11.  
  12. #include "include.h"
  13. #include "../h/fasl.h"
  14. #include "../h/fasl_global.h"
  15.  
  16. #ifdef AOSVS
  17. #define ERSNF        077014    /* symbol not found error */
  18. #endif
  19. int    debug;
  20.  
  21. init_pass1()
  22. {
  23.     short    i = 0;
  24.  
  25.     fas_buffp = fas_io_buff;
  26.     fas_temp_buff = fas_table_buff;
  27.     fas_routine_addr = 0;    /* initialize routine addr */
  28.  
  29.     zero(fas_temp_buff, FAS_BUFF_LEN);
  30. /*    zero((char *)fas_map, FAS_MAP_SIZE * 4);    */
  31.     fas_temp_curr = fas_temp_last = 0;
  32. #ifdef AOSVS
  33.     if (fas_stchan == -1) fasl_openst();
  34. #endif
  35.     fasl_open_temp();
  36.  
  37.     max_part_no = 0;
  38.     for (i = 1; i <= MAX_SYS_PART; i++)
  39.         fasl_new_table();
  40.  
  41.     fas_relocation_by_table = TRUE;
  42.     vs_base_no = vs_top_no = fas_short_no = -1;
  43. }
  44.  
  45. data_pass1()
  46. {
  47.     FAS_HDR_P    hdr_p;
  48.     FAS_DATA_P    data_p;
  49.     short    base, reloc, reloc_ex;
  50.     short    *base_p, *dword_p;
  51.     int    obnum, repeat_count, displacement;
  52.     int    words, total_len, over_write;
  53.  
  54.     /* set up pointers */
  55.     hdr_p = (FAS_HDR_P)fas_buffp;
  56.     data_p = (FAS_DATA_P)(fas_buffp + FAS_HEADER_BLEN);
  57.  
  58.     obnum = hdr_p->hdr_num;    /* block number */
  59.     base = data_p->data_base;
  60.     if (datab_rev < 2)
  61.         repeat_count = 1;
  62.         else
  63.         repeat_count = data_p->data_repeat;
  64.     words = (int)(data_p->data_words) * repeat_count;
  65.  
  66.     if (base > max_part_no) fasl_invalid();
  67.  
  68.     /* relocation */
  69.     base_p = &base;
  70.     dword_p = &(data_p->data_disp);
  71.     reloc = (data_p->data_reloc) & RELOC_OP;
  72.     reloc_ex = ((data_p->data_reloc) & RELOC_OP_EX) >> RELOC_OP_S;
  73.     if (reloc != EX_RELOC) unexpect_reloc(reloc);
  74.  
  75.     relocation(reloc_ex, base_p, dword_p);
  76.  
  77.     displacement = data_p->data_disp;
  78.     part_table_p = fasl_get_table(base);
  79.     total_len = part_table_p->part_len;
  80.     if ((displacement + words) > total_len)
  81.         total_len = displacement + words;
  82.     part_table_p->part_len = total_len;
  83. }
  84.  
  85. titl_pass1()
  86. {
  87.     FAS_HDR_P    hdr_p;
  88.     FAS_TITL_P    titl_p;
  89.  
  90.     short        bnum;
  91.     char        title_buff[MAX_TITLE+1];
  92.     char        *work_ptr, *work_ptr1;
  93.         short        title_len;
  94.     
  95.     bnum = ((FAS_HDR_P)fas_buffp)->hdr_num;
  96.     if (bnum != 1) fasl_invalid();
  97.  
  98. /*
  99.     titl_p = (FAS_HDR_P)(fas_buffp + FAS_HEADER_BLEN);
  100.  
  101.     title_len = titl_p->titl_len;
  102.     work_ptr = fas_buffp + (titl_p->titl_ptr);
  103.     work_ptr1 = title_buff;
  104.  
  105.     while ( title_len-- > 0)
  106.         *(work_ptr1++) = *(work_ptr++);
  107.     *work_ptr1 = '\0';
  108.  
  109.     if (debug) printf(";   Loading %s\n",title_buff);
  110. */
  111. }
  112.  
  113. ext_pass1()
  114. {
  115.     FAS_HDR_P    hdr_p;
  116.     FAS_ENT_P    ent_p;
  117.     FAS_NAME_P    name_p;
  118.  
  119.     short    base, sym_count, symbol_len;
  120.     char    *work_ptr, *work_ptr1;
  121.     int    symval;
  122.     int    ier;
  123.  
  124.     /* set up pointers */
  125.     hdr_p = (FAS_HDR_P)fas_buffp;
  126.     ent_p = (FAS_ENT_P)(fas_buffp + FAS_HEADER_BLEN);
  127.     name_p = (FAS_NAME_P)(ent_p + 1);
  128.  
  129.     sym_count = ent_p->ent_count;
  130.  
  131.     while (sym_count-- > 0) {
  132.        part_table_p = fasl_new_table();
  133.        part_table_p->part_symbol = TRUE;
  134.                     /* set symbol flag */
  135.        symbol_len = (name_p->name_len) & L_MASK;
  136.  
  137.        work_ptr = fas_buffp + (name_p->name_ptr);
  138.        work_ptr1 = part_table_p->part_name;
  139.        while(symbol_len-- > 0)        /* copy symbol */
  140.         *work_ptr1++ = *work_ptr++;
  141.        ier = fasl_st(part_table_p->part_name, &symval);
  142. #ifdef AOSVS
  143.        if (ier != 0)
  144.         if (ier == ERSNF)
  145.             /* ignore .REQUIRE_LANG_RT_REV_??.?? */
  146.             if ((name_p->name_len) & L_MASK < 16 ||
  147.                 strncmp(part_table_p->part_name,
  148.                     ".REQUIRE_LANG_RT", 16) != 0) {
  149.                 fasl_undefined(part_table_p->part_name);
  150.                 } else {
  151.                 part_table_p->part_addr = -1;
  152.                 }
  153.             else
  154.             sys_emes(ier);
  155.         else
  156.         part_table_p->part_addr = symval;
  157. #endif
  158. #ifdef DGUX
  159.        if (ier != 0)
  160.         /* ignore .REQUIRE_LANG_RT_REV_??.?? */
  161.         if ((name_p->name_len) & L_MASK < 16 ||
  162.             strncmp(part_table_p->part_name,
  163.                 ".REQUIRE_LANG_RT", 16) != 0) {
  164.             fasl_undefined(part_table_p->part_name);
  165.         } else 
  166.             part_table_p->part_addr = -1;
  167.        else
  168.         part_table_p->part_addr = symval;
  169. #endif
  170.  
  171.        name_p += 1;            /* advance for next symbol */
  172.     }
  173. }
  174.  
  175. pat_pass1()
  176. {
  177.     FAS_HDR_P    hdr_p;
  178.     FAS_PAT_P    pat_p;
  179.     FAS_PATD_P    patd_p;
  180.  
  181.     short    base, pat_count, flags;
  182.     long    p_len;            /* partition length */
  183.     short    p_name_len;        /* partion name length */
  184.     char    *work_ptr, *work_ptr1;
  185.     int    symval;
  186.     int    ier;
  187.  
  188.     /* set up pointers */
  189.     hdr_p = (FAS_HDR_P)fas_buffp;
  190.     pat_p = (FAS_PAT_P)(fas_buffp + FAS_HEADER_BLEN);
  191.     patd_p = (FAS_PATD_P)(pat_p + 1);
  192.  
  193.     pat_count = pat_p->pat_count;
  194.  
  195.     while (pat_count-- > 0) {    /* for each descripter */
  196.        part_table_p = fasl_new_table();
  197.  
  198.        flags = patd_p->patd_flag;    /* various flags */
  199.        part_table_p->part_align = (flags & PAT_ALN) >> PAT_ALN_S;
  200.        if (part_table_p->part_align > 1) fasl_align_error();
  201.  
  202.        part_table_p->part_global = (flags & PAT_BASE) >> PAT_BASE_S;
  203.        part_table_p->part_len = patd_p->patd_len;
  204.        p_name_len = (patd_p->patd_nlen) & L_MASK;
  205.  
  206.        /* check short NREL */
  207.        if (((flags & PAT_NREL) != 0) &&
  208.            (part_table_p->part_global == FALSE)) {
  209. /*        part_table_p->part_addr = fas_short_nrel;    */
  210.         fas_short_no = part_table_p->part_no;
  211.         goto NEXT;
  212.        }
  213.        work_ptr = fas_buffp + (patd_p->patd_nptr);
  214.        work_ptr1 = part_table_p->part_name;
  215.        while (p_name_len-- > 0)        /* copy name */
  216.         *work_ptr1++ = *work_ptr++;
  217.  
  218.        if (vs_base_no < 0 &&
  219.            strcmp(part_table_p->part_name, "vs_base") == 0)
  220.         vs_base_no = part_table_p->part_no;
  221.        else if (vs_top_no < 0 &&
  222.             strcmp(part_table_p->part_name, "vs_top") == 0)
  223.         vs_top_no = part_table_p->part_no;
  224.  
  225.        if (part_table_p->part_global == FALSE) goto NEXT;
  226.        ier = fasl_st(part_table_p->part_name, &symval);
  227. #ifdef AOSVS
  228.        if (ier == ERSNF) {
  229.         FEerror("Internal entry ~S not found.", 1,
  230.                make_simple_string(part_table_p->part_name));
  231.        } else
  232.         if (ier != 0)
  233.              sys_emes(ier);
  234.             else
  235.             part_table_p->part_addr = symval;
  236. #endif
  237. #ifdef DGUX
  238.        if (ier != 0) {
  239.         FEerror("Internal entry ~S not found.", 1,
  240.                make_simple_string(part_table_p->part_name));
  241.        } else
  242.         part_table_p->part_addr = symval;
  243.  
  244. #endif
  245. NEXT:
  246.        patd_p += 1;            /* advance for next */
  247.     }
  248. }
  249.  
  250. rev_pass1()
  251. {
  252.     FAS_HDR_P    hdr_p;
  253.     FAS_REV_P    rev_p;
  254.     FAS_REVD_P    revd_p;
  255.  
  256.     short    bnum, rev_count, block_type;
  257.  
  258.     bnum = ((FAS_HDR_P)fas_buffp)->hdr_num;
  259.     if (bnum != 2) fasl_invalid();
  260.  
  261.     rev_p = (FAS_REV_P)(fas_buffp + FAS_HEADER_BLEN);
  262.     revd_p = (FAS_REVD_P)(rev_p + 1);
  263.  
  264.     rev_count = rev_p->rev_count;
  265.  
  266.     while ( rev_count-- > 0) {
  267.        block_type = (revd_p->revd_btyp) & BLOCK_TYPE;
  268.        if (block_type != DATA_BLOCK) continue;
  269.        datab_rev = (revd_p->revd_brev);    /* data block rev */
  270.  
  271.        if (datab_rev > 2) fasl_rev_error();
  272.  
  273.        revd_p += 1;        /* advance for next */
  274.     }
  275. }
  276.  
  277. aln_pass1()
  278. {
  279.     FAS_HDR_P    hdr_p;
  280.     FAS_ALN_P    aln_p;
  281.  
  282.     short    base, power;
  283.  
  284.     aln_p = (FAS_ALN_P)(fas_buffp + FAS_HEADER_BLEN);
  285.  
  286.     base = aln_p->aln_base;
  287.     part_table_p = fasl_get_table(base);
  288.     part_table_p->part_align = aln_p->aln_power;
  289. }
  290.  
  291. unexpected()
  292. {
  293.  
  294.     short    block_type, block_num;
  295.  
  296.     block_type = (((FAS_HDR_P)fas_buffp)->hdr_typ) & BLOCK_TYPE;
  297.     block_num = ((FAS_HDR_P)fas_buffp)->hdr_num;
  298.  
  299.     if (debug) {
  300.         printf("unexpected FASL block\n");
  301.         printf("  block type   : %d\n", block_type);
  302.         printf("  block number : %d\n", block_num);
  303.     }
  304.     fasl_invalid();
  305. }
  306.  
  307. /* set symbol value in partition table */
  308. /*
  309. fasl_ssym()
  310. {
  311.     int        symval, i, ier;
  312.     char        *symp;
  313.  
  314.     for (i = MAX_SYS_PART + 1; i <= max_part_no; i++) {
  315.        part_table_p = fasl_get_table(i);
  316.        if ((part_table_p->part_symbol == FALSE) &&
  317.            (part_table_p->part_global == FALSE)) continue;
  318.        symp = part_table_p->part_name;
  319.        ier = fasl_st(symp, &symval);
  320. #ifdef AOSVS
  321.        if (ier == ERSNF)
  322.         if (part_table_p->part_symbol == TRUE)
  323.             fasl_undefined(symp);
  324.             else
  325.             continue;
  326.         else
  327.         if (ier != 0) sys_emes(ier);
  328. #endif
  329. #ifdef DGUX
  330.        if (ier != 0)
  331.         if (part_table_p->part_symbol == TRUE) fasl_undefined(symp);
  332. #endif
  333.        part_table_p->part_addr = symval;
  334.     }
  335. }
  336. */
  337.  
  338. fasl_len()
  339. {
  340.  
  341.     int        caddr, p_len;
  342.     short        p_align, i;
  343.  
  344.     caddr = 0;
  345.     for (i = 0; i < max_part_no; i++) {
  346.        if (i == fas_short_no) continue;
  347.        part_table_p = fasl_get_table(i);
  348.        if ((part_table_p->part_global == TRUE) &&
  349.            (part_table_p->part_addr != 0)) continue;
  350.        p_len = part_table_p->part_len;
  351.        p_align = part_table_p->part_align;
  352.        caddr = fasl_align(caddr, p_align) + p_len;
  353.        }
  354.     caddr += 2;
  355.         /* 1 word for actual length
  356.            1 word for alignment gap */
  357.         /* warning : for above alignment gap to be  proper
  358.            all alignment power must be less or equal to 1 */
  359.  
  360.     return(caddr);
  361. }
  362.  
  363. fasl_align(caddr, power)
  364. int    caddr;
  365. short    power;
  366. {
  367.     int    mask;
  368.  
  369.     mask = (1 << power) - 1;
  370.     if ((caddr & mask) == 0) return(caddr);
  371.     return((caddr | mask) + 1);
  372. }
  373.  
  374. fasl_saddr()
  375. {
  376.     short    *caddr;
  377.     int    i, part_len;
  378.     int    recno, ind;
  379.     short    part_align;
  380.  
  381.     caddr = fas_rstart;    /* set current to starting addr */
  382.     fas_addr_rec_first = fas_temp_last + 1;
  383.     fas_addr_rec_curr = 0;
  384.  
  385.     zero(fas_addr_buff, FAS_BUFF_LEN);
  386.  
  387.     for (i = 0; i <= max_part_no; i++) {
  388.        part_table_p = fasl_get_table(i);
  389.        if ((part_len = part_table_p->part_len) == 0 ||
  390.            part_table_p->part_addr != 0) {
  391.            recno = i / FAS_ADDRS_IN_REC;
  392.            ind = i % FAS_ADDRS_IN_REC;
  393.            if (recno > fas_addr_rec_curr) {
  394.             fasl_write_addr_rec(fas_addr_rec_curr);
  395.             fas_addr_rec_curr++;
  396.             zero(fas_addr_buff, FAS_BUFF_LEN);
  397.            }
  398.            ((int *)fas_addr_buff)[ind] = part_table_p->part_addr;
  399.         continue;
  400.        }
  401.        part_align = part_table_p->part_align;
  402.        caddr = fasl_align((int)caddr, part_align);
  403.        part_table_p->part_addr = caddr;
  404.        recno = i / FAS_ADDRS_IN_REC;
  405.        ind = i % FAS_ADDRS_IN_REC;
  406.        if (recno > fas_addr_rec_curr) {
  407.         fasl_write_addr_rec(fas_addr_rec_curr);
  408.         fas_addr_rec_curr++;
  409.         zero(fas_addr_buff, FAS_BUFF_LEN);
  410.        }
  411.        ((int *)fas_addr_buff)[ind] = caddr;
  412.        caddr = caddr + part_len;
  413.     }
  414.     fasl_write_addr_rec(fas_addr_rec_curr);
  415. }
  416.  
  417. check_short_area()
  418. {
  419.     if (fas_short_no < 0) return;
  420.     part_table_p = fasl_get_table(fas_short_no);
  421.     if (part_table_p->part_len == 0) return;
  422.     if (fas_short_nrel + part_table_p->part_len > fas_short_end)
  423.         FEerror("Not enough FASL short nrel area.", 0);
  424.  
  425.     part_table_p->part_addr = fas_short_nrel;
  426.  
  427.     /* for next */
  428.     fas_short_nrel += part_table_p->part_len;
  429. }
  430.